home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / os2 / srefv112.zip / GETAFILE.80 < prev    next >
Text File  |  1996-05-14  |  30KB  |  906 lines
  1. /*********************************
  2.     GETAFILE  :   Displays files in a selected subdirectory (of the data
  3.                   directory, and allows you to retrieve a file.
  4.  
  5.          Usage:  Set up a link with href="/getafile?DIR=/adir&option1&option."
  6.  
  7.             where adir is the directory (under the data directory
  8.             in GOSERVE) whose files will be displayed.
  9.  
  10.             By default,only files in the directory will be displayed
  11.  
  12.     Options understood by GETAFILE:
  13.  
  14.             : DIR=dirname .
  15.                  Dirname is actually the subdirectory under the
  16.                  data directory (data directory is often /GOHTTP).
  17.                  Thus,  DIR=/ means "display contents of Data directory"
  18.  
  19.                  Note: if DIR= is missing, then defaults to data directory.
  20.  
  21.             : ISCREATE=amessage.
  22.                 If ISCREATE is present, then suppress all descriptive information
  23.                 except an H2 of amessage.
  24.  
  25.  
  26.             : SHOWDIR=YES.
  27.                Display subdirectories
  28.                as links back to GETAFILE (allows you to traverse the
  29.                directory tree).  Parent is also included, but NOT if
  30.                DIR=/ (that is, the root of the data directory can not
  31.                be gotten below).
  32.  
  33.           :  ROOTDIR=rootname
  34.  
  35.              If you don't want the client to be able to view files beneath some
  36.              root directory, enter it here.  Note that ROOTNAME must be an
  37.              abbreviation of DIR (otherwise, DIR will not be displayed)
  38.              
  39.              To specify the DIR as the ROOTDIR (on first call to GETAFILE), enter
  40.              ROOTDIR=!
  41.  
  42.              If no ROOTDIR restriction is desired, set ROOTDIR=0 (or leave it out)    
  43.  
  44.           : header=a+header+
  45.                The message string will be inserted as an <H2> at the
  46.                top of the document.
  47.                For example, message string could be
  48.                (From+our+staff)  == note the use of URL encoding!
  49.                If not specified, a default header is used (you should set HEADER=0, or
  50.                leave HEADER out)
  51.                
  52.             
  53.            : DISPFILE=filename.ext+Message+about+file
  54.                       Displays the contents of filename along with the
  55.                       filelist. DISPFILE is assumed to be in DIR.
  56.                       The Message about the file is displayed using a <H3>
  57.  
  58.  
  59.  
  60.            : LINES=nlines
  61.                         displays no more then nlines from filename
  62.  
  63.            : TOP=YES
  64.                         display file before filelist (default is after)
  65.  
  66.             : GIFS=YES
  67.                     Put a cute gif next to
  68.                     the filename (or directory).  This idea (and icons)
  69.                     are "borrowed" from the GOHTTP server package of Don Meyer.
  70.  
  71.             : TABLE = DIR, FILE, or KEY
  72.                     Write stuff in a table.
  73.                        DIR = Put the files &  subdirectories in column 2-tablecols,
  74.                        FILES  = Create a 3 column table,
  75.                                 column 1 = file & directory names
  76.                                 column 2,3 = File size and file datd
  77.                                 column 4 = Line from 'dispfile' filename
  78.                         (actually, this is subject to SHOWDATE and SHOWSIZE)
  79.  
  80.                        KEY.  Similar to FILE, but instead of displaying
  81.                               the ith line of filename in the ith row of the
  82.                               table, a Key search is performed on filename,
  83.                               where the key being looked for is 
  84.                                 {afile.1a} xx {afile.2} etc.  If the file
  85.                                 name (in column 1) matches this key (i.e. afile.1a)
  86.                                 then xxx is displayed in column 3.
  87.  
  88.                     If no TABLEFILE selected, then column 4 is blank.
  89.  
  90.              : TABLEFILE=FILENAME+a+Message
  91.                   Used if TABLE=KEY or TABLE=FILE (contains info on each file & directory)
  92.                   
  93.              : TABLECOLS= # colums
  94.                       By default, equals 4 (used only if TABLE=DIR)
  95.                  If set to 0, then use a <DL> list (useful if TABLE is
  96.                  not supported).
  97.  
  98.              : USEDL = YES or NO
  99.                  If TABLE =FILE or KEY, and USEDL=YES, then
  100.                  use a <DL> list instead of a table.
  101.  
  102.              : DISPFILE=filename.ext
  103.                       Displays the contents of filename along with the
  104.                       filelist. DISPFILE is assumed to be in DIR.
  105.  
  106.  
  107.  
  108.           : IMGDIR=director
  109.                 If IMGDIR, then the cute gifs are expected to be
  110.                 in the /IMGS subdirectory of the  data directory 
  111.                   (hint: specify this as a hidden  element in a form).
  112.                 example: imgdir="/IMGS2" would look in d:/gohttp/imgs2 if
  113.                      d:/gohttp were your datadirectory
  114.                 If IMGDIR not specified, then the cute gifs are assumed
  115.                 to be in data_directory/IMGS
  116.  
  117.            : SHOWDATE = YES
  118.                  Display the file creation date.
  119.  
  120.            : SHOWSIZE = YES
  121.                  Display the file's size
  122.  
  123.            : RECORD=YES
  124.                       Use the SENDFILE procedure to record/control
  125.                       file has been transfer.  See documentation
  126.                       of SENDFILE for details. You probably want to
  127.                       make this a hidden element.
  128.  
  129.            : ACCESS=access_code
  130.                       Used if RECORD=YES, as access control information.
  131.  
  132.            : FORCETEXT=YES or NO
  133.                   If YES, SENDFILE assumes ALL files are text/plain mime type
  134.  
  135.    Example:
  136.  
  137. /getafile?/public&header=Public+Files&dispfile=READ.ME&displine=40&GIFS&dirs
  138.  
  139.     Would find all files in /public (relative to the
  140.     data directory), write a H2 header of "Public Files"
  141.     display the READ.ME file, and note the files with a gif.
  142.                  
  143.    NOTE: If your client's browser does not support tables,
  144.          the TABLE option is a bad idea!
  145.  
  146.      Note that for security, only files and directories under the
  147.      working directory are accessible (the .. syntax is ignored).
  148.  
  149.      Also, if you are controlling access to files using RECORD=YES
  150.      (that is, using the SENDFILE facility to determine who has rights
  151.       to download the file), then any clever idiot could simply remove the
  152.       RECORD=YES option, and thereby sidestep the call to SENDFILE.
  153.       So... don't use this if security is truely important!!
  154.  
  155. ************************/
  156. getafile:
  157.  
  158.  
  159. parse arg ddir,tempfile,sel,list,averb,auri,auser,abd,awd,apri,infiles
  160.  
  161. list=translate(list, ' ', '+'||'090a0d'x)  /* Whitespace, etc. */
  162.  
  163. parse var infiles params ',' access_file ',' userfile ',' virtual_file ',' alias_file ',' sendfile_file
  164. parse upper var params allow_access nog macrospace_input
  165.  
  166. userfile=strip(userfile) ; access_file=strip(access_file); 
  167. virtual_file=strip(virtual_file) ; alias_file=strip(alias_file)
  168. sendfile_file=strip(sendfile_file)
  169.  
  170.  
  171. imagepath=translate("/imgs/")
  172. imagesize="width=24 height=24"
  173. list=packur(list)               /* fix up */
  174.  
  175. dirgif='<img src="'ImagePath'menu.gif"' size 'alt="[dir] ">'
  176. backgif='<img src="'ImagePath'back.gif"' size 'alt="[..] ">'
  177.  
  178. /* since we might use tables, use netscape dtd rather the 2.0 */
  179.   call lineout tempfile,' <!DOCTYPE HTML PUBLIC  "-//Netscape Comm. Corp.//DTD HTML//EN">'
  180.   call lineout tempfile, "<html><head><title>Upload a File</title></head>"
  181.   call lineout tempfile, "<body>"
  182.  
  183. /* retain old message (a record of directory traverses */
  184.  
  185. oldmess=list
  186. oldmess=translate(oldmess,'+',' ')
  187. if left(oldmess,4)="DIR=" then do
  188.     foo1=pos('&',oldmess)
  189.     oldmess=delstr(oldmess,1,foo1)
  190. end
  191. else do
  192.   foo1=pos("&DIR=",oldmess)
  193.   if foo1>0 then do
  194.     foo2=pos('&',oldmess,foo1+1)
  195.     if foo2>0 then
  196.        oldmess=delstr(oldmess,foo1+1,foo2-foo1)
  197.   end
  198. end
  199. oldmess='&'||oldmess
  200.  
  201. messages=list
  202.  
  203. /* Get options */
  204. showgifs=0 ; maxlines=1000000 ;  readmefile=0
  205. attop=0 ; dirtable=0  ; filetable=0 ;defcols=4
  206. dodirs=0 ;  header=0; filekey=0  ; dorecord=0
  207. access_code='na'  ; showdate=0; showsize=0
  208. forcetext=0 ; tablefile=0 ; usedl=0 ; rootdir=0 ; 
  209. readmefile_mess=0  ; dirtop=0
  210. tablefile_mess=0 ; iscreate=0
  211. adir="/"
  212.  
  213. do until messages=" "
  214.  
  215.   parse var messages amess '&' messages
  216.   parse var amess messname '=' messval
  217.   messval=packur(translate(messval,' ','+'||'0d0a09'x))
  218.  
  219.   messname=translate(messname) ; messval=translate(messval)
  220.  
  221.   select
  222.  
  223.     when  "DIR"=messname then
  224.  
  225.         adir=messval
  226.  
  227.     when message="IMGDIR" then do
  228.       messval="/"||strip(messval,,'\')||"/"
  229.       imagepath=translate(messval,'/'.'\')
  230.     end
  231.  
  232.     when messname="HEADER" then
  233.         header=messval
  234.  
  235.     when messname="GIFS" then
  236.         if messval="YES" then
  237.            showgifs=1
  238.  
  239.     when messname="DISPFILE" then do
  240.         tmp=messval
  241.         if  tmp="" | tmp=0 then
  242.            readmefile=0
  243.         else
  244.            parse var  tmp readmefile readmefile_mess
  245.         if readmefile_mess="" then readmefile_Mess=0
  246.  
  247.       end
  248.  
  249.     when messname="TABLEFILE" then do
  250.         tmp=messval
  251.         if tmp=" " | tmp="" then
  252.              tablefile=0
  253.         else
  254.            parse var tmp tablefile tablefile_mess
  255.          if tablefile_mess="" then tablefile_Mess=0
  256.       end
  257.  
  258.  
  259.     when messname="TABLE" then
  260.       select
  261.         when pos("KEY",messval)>0 then do 
  262.            filetable=1 
  263.            filekey=1 
  264.         end
  265.         when pos("FILE",messval)>0 then do
  266.            filetable=1 
  267.             filekey=0 
  268.          end
  269.          when pos("DIR",messval)>0 then
  270.                 dirtable=1
  271.          otherwise
  272.        end
  273.  
  274.     WHEN MESSNAME="RECORD" THEN
  275.         IF messval="YES" then dorecord=1
  276.  
  277.    WHEN MESSNAME="SHOWDATE" THEN
  278.         IF messval="YES" then showdate=1
  279.  
  280.    WHEN MESSNAME="SHOWSIZE" THEN
  281.         IF messval="YES" then showsize=1
  282.  
  283.     when messname="COLS" then
  284.         if datatype(messval)="NUM" then tablecols=messval
  285.  
  286.  
  287.    when messname="ISCREATE" then do
  288.         header=messval
  289.         iscreate=1
  290.     end
  291.  
  292.     when messname="USEDL" then
  293.         IF messval="YES" then usedl=1
  294.  
  295.  
  296.     when messname="ROOTDIR" then
  297.         rootdir=messval
  298.  
  299.     when pos("LINE",messname)>0 then
  300.         if datatype(messval)="NUM" then maxlines=messval
  301.  
  302.     when pos("TOP",messname) > 0 then
  303.         if messval="YES" then        attop=1
  304.  
  305.     when pos("SHOWDIR",messname)>0 | pos("SUBDIR",messname)>0 then do
  306.         dodirs=1
  307.         if messval="TOP" then
  308.            dirtop=1
  309.    end
  310.    when messname="USERNAME" | messname="ACCESS" then do
  311.          access_code=messval
  312.          if access_code="" then access_code="na"
  313.    end
  314.  
  315.    when messname="FORCETEXT" then
  316.          if messval=1 | abbrev(messval,'Y')=1 then forcetext=1
  317.  
  318.      otherwise
  319.  
  320.    end           /* select messname */
  321.  
  322.  end            /* loop */
  323.  
  324.  
  325.  adir=translate(strip(adir),'/','\')
  326.  adir=strip(adir,'t','/')
  327.  
  328.  foodir=adir
  329.  
  330.  if abbrev(translate(rootdir),"!")=1 then rootdir=foodir
  331.  
  332.  
  333.  if datatype(tablecols)<>"NUM" then            /* default # table columns */
  334.     tablecols=defcols-showgifs
  335.  
  336.  if header="" | header=0 then  header=' List of files in ' ||foodir
  337.  
  338.  if tablecols=0 & dirtable=1 then tablecols=1
  339.  
  340.  
  341. /*  lookdir2=translate(adir,'\','/')*/
  342.    lookdir2=adir
  343.    tmp=lookdir2||'/*.*'
  344.    lookin=sref_do_virtual(ddir,tmp,macrospace_input,virtual_file)
  345.    dp=strip(filespec('d',lookin)||filespec('p',lookin),'t','\')
  346.     wade=directory()
  347.     notwade=directory(dp)
  348.     wade0=directory(wade)
  349.  
  350.    if lookin = " " | lookin=0 | notwade="" then do               /* ERROR */
  351.      call error_0
  352.      return 'FILE ERASE TYPE text/html NAME' tempfile
  353.    end
  354.  
  355. /* if here, directory exists so get its files and subds */
  356.    rc = SysFileTree(lookin,'flist', 'F')
  357.    if rc <> 0 then do    /* error */
  358.      call error_1
  359.      return 'FILE ERASE TYPE text/html NAME' tempfile
  360.    end
  361.  
  362.    thepath=delstr(lookin,pos('\*.*',lookin))
  363.    say " Getting files from " thepath 
  364.  
  365. /* Else,  create list of links to files */
  366.    do i=1 to flist.0
  367.        parse var flist.i adate ee2 asize ee3 fname
  368.        if asize>99999 then do
  369.           asize=trunc(asize/1000)||'K'
  370.        end
  371.        afil=filespec("name",fname)
  372.  
  373.        flist.i.afile=afil
  374.        flist.i.size=asize
  375.        flist.i.date=adate 
  376.        afil2=adir||"/"||afil
  377.        if dorecord=1 then  
  378.            afil2="SENDFILE?"||afil2||'&ACCESS='||access_code||'&FORCETEXT='||forcetext
  379.  
  380.        if filetable=1 & tablefile<>0 & usedl=0 then    /*force size/date in own column*/
  381.           if showgifs=1 then do
  382.              agif=imagetype(afil)
  383.              flist.i.name='  '  agif ' <a href="' || afil2|| '>' afil  '</a> '
  384.          end
  385.          else
  386.              flist.i.name='  <a href="' || afil2|| '">' afil  '</a>  '
  387.  
  388.        else  do            /* put size/date with name */
  389.           jasize=asize ; if showsize=0 then jasize=' '
  390.           jadate=adate ; if showdate=0 then jadate= ' '
  391.           dl1='(' ; dl2=',' ; dl3=')' ;
  392.           if jadate=' ' & jasize=' ' then do ; dl1=' ' ; dl2=' '; dl3=' '; end
  393.           if jasize=' ' then  dl2=' '
  394.           if jadate=' ' then  dl2=' '
  395.  
  396.           if showgifs=1 then do
  397.              agif=imagetype(afil)
  398.              flist.i.name='  '  agif ' <a href="' || afil2|| '">' afil  '</a>' ,
  399.                           dl1 jasize dl2 jadate dl3
  400.           end
  401.           else
  402.              flist.i.name='  <a href="' || afil2|| '">' afil  '</a> ' ,
  403.                             dl1 jasize dl2 jadate dl3
  404.        end            /* put size/date */
  405.   end    /* i 1 to flist.0 */
  406.  
  407.   oldmess2=oldmess
  408.  
  409. /* replace DIR= with OLDDIR= (retained for grins, not actually used by getafile) */
  410.    oldmess2=sref_replacestrg(oldmess2,'&DIR=','&DIROLD=')
  411.    if abbrev(oldmess2,'DIR=')=1 then
  412.       oldmess2=sref_replacestrg(oldmess2,'DIR=','DIROLD=')  /* just do the first one */
  413.  
  414. /*replace ROOTDIR="!" with ROOTDIR=rootdir (the variable's value) */
  415.    oldmess2=sref_replacestrg(oldmess2,'=!','='||rootdir)
  416.  
  417. /* get subdirectories ? */
  418.  
  419.   if dodirs=1 then do
  420.      rc2=sysfiletree(lookin,dirlist,"OD")
  421.      if rc2 <> 0 then do    /* error */
  422.        call error_3
  423.        return 'FILE ERASE TYPE text/html NAME' tempfile
  424.      end
  425.      do mm=1 to dirlist.0
  426.        parse var dirlist.mm (thepath) teco
  427.        dirlist.mm=translate(adir||teco,'/','\')
  428.      end
  429.  
  430.  
  431. /*   create list of directories, and add the .. directory if needed */
  432.      LP1=LASTPOS('/',ADIR)
  433.      do mm=dirlist.0 to 1 by -1  /* move 'em down */
  434.            if adir<>"" then
  435.               mm1=mm+1
  436.            else 
  437.               mm1=mm
  438.            dirlist.mm1=dirlist.mm
  439.            dirg=dirlist.mm1
  440.            dirg0=translate(dirg,' ','/\'); dirg0=word(dirg0,words(dirg0))
  441.            dirlist.mm1.aname=dirg
  442.            dirg2=translate(dirg,'/','\')
  443.            dirg2="/GETAFILE?DIR="||dirg2||oldmess2
  444.            if showgifs=1 then
  445.               dirlist.mm1.name='  ' dirgif ' <a href="' ||dirg2|| '"> '|| dirg0 ||   ' </a>'
  446.            else
  447.               dirlist.mm1.name='  <a href="' ||dirg2|| '"> '|| dirg0 ||   ' </a>'
  448.  
  449.       end
  450.       if adir<>""  then do              /* if not at root */
  451.         dirlist.0=dirlist.0+1
  452.         IF LP1>1 THEN DO ;           /*below first level subdirectory */
  453.            DIRG1=SUBSTR(ADIR,1,LP1-1) ;
  454.            dirlist.1.aname=dirg1
  455.            dirlist.1=dirg1
  456.            if showgifs=1 then
  457.               dirlist.1.name=' ' dirgif ' <A HREF="/GETAFILE?DIR='||DIRG1||oldmess2'"> (.. parent) </A>'
  458.            else
  459.               dirlist.1.name=' <A HREF="/GETAFILE?DIR='||DIRG1||oldmess2'"> (.. parent) </A>'
  460.         END
  461.         ELSE do   /* must be 1st level directory, so display root */
  462.            dirlist.1=""
  463.            if showgifs=1 then 
  464.               dirlist.1.name=' ' backgif ' <A HREF="/GETAFILE?DIR=/'||oldmess2||'"> ..  (parent) </A>'
  465.            else
  466.               dirlist.1.name=' <A HREF="/GETAFILE?DIR=/'||oldmess2||'"> ..  (parent) </A>'
  467.            dirlist.1.aname=""
  468.  
  469.         end
  470.      END            /* add parent */
  471.  
  472.  
  473. /* rootdir condition check */
  474.     rootdir=strip(rootdir); rootdir=translate(rootdir,'/','\')
  475.     rootdir=strip(rootdir,,'/')
  476.     do m=1 to dirlist.0
  477.        if rootdir<>0 then do
  478.           t1=translate(dirlist.m.aname,'/','\')
  479.           t2=strip(dirlist.m.aname,,'/')
  480.           dirlist.ok.m=abbrev(t2,rootdir)
  481.        end
  482.        else
  483.            dirlist.ok.m=1
  484.     end
  485.  
  486.   end                   /* dodirs */
  487.  
  488. /* read in the file, if wanted */
  489. readmelines.0=0
  490. if readmefile<>0 then do
  491.    yow=thepath||'\'||readmefile
  492.    nlines=fileread(yow,'filelines')
  493.    readmelines.0=nlines
  494.    if nlines>0 then
  495.      do pp=1 to nlines
  496.        readmelines.pp=filelines.pp
  497.      end
  498.    else do
  499.      readmefile=0  /* signal no success */
  500.      say " Could not find " readmefile
  501.    end
  502.  
  503. end
  504. if tablefile<>0 & filekey=1 then do   /*key matching table */
  505.     dispdata=sref_grab_file(thepath||'\'tablefile,30)
  506.     if dispdata=0 then do
  507.       tablefile=0 ; tablefile_mess=0
  508.       dispdata=""
  509.     end
  510. end
  511. tablelines.0=0
  512. if tablefile<>0 & filetable=1 & filekey=0 then do  /* line matching table */
  513.    yow=thepath||'\'||tablefile
  514.    nlines=fileread(yow,'filelines')
  515.  
  516.    tablelines.0=nlines
  517.    if nlines=0 then do
  518.         tablefile=0 ; tablefile_mess=0
  519.    end
  520.    else
  521.      do pp=1 to nlines
  522.        tablelines.pp=filelines.pp
  523.      end
  524. end
  525.  
  526. /* intro to this htm */
  527. call lineout tempfile,'<h2> ' header ' </h2>'
  528.  
  529.  
  530. if readmefile<>0 & attop=1  then do
  531.     call showdafile(readmelines.0)
  532. end
  533.  
  534. if iscreate=0 then do
  535.   call lineout tempfile,"  <strong> " FLIST.0 " Files in " foodir " </strong> "
  536.   CAll lineout tempfile," <p> Select the file you want to retrieve "
  537.   call lineout tempfile,' <em> You might need to turn on your browser''s "Save to file mode" option </em>'
  538. end
  539.  
  540.  
  541. /*** table stuff complicates things !! */
  542.  
  543.  
  544. select
  545. /* no table */
  546.    when dirtable+filetable=0  then do   /* no table */
  547.  
  548.  
  549.      if dodirs=1 & dirtop=1 then do
  550.        
  551.        if iscreate<>1 then do
  552.          if adir="" then
  553.             call lineout tempfile, " <hr> <h3> Subdirectories </h3>"
  554.          else
  555.             call lineout tempfile, " <hr> <h3> Subdirectories of " adir ' </h3>'
  556.       end
  557.       else
  558.                 call lineout tempfile," <br> "
  559.  
  560.        call lineout tempfile, " <menu>  "
  561.        if dirlist.0=0 then
  562.          call lineout tempfile,' <LI> No subdirectories! '
  563.        else
  564.          do mm=1 to dirlist.0
  565.             if dirlist.ok.mm=1 then
  566.                 call lineout tempfile,' <li> ' dirlist.mm.name
  567.          end
  568.        call lineout tempfile,' </menu>  '
  569.      end                        /* dirall */
  570.  
  571.     if iscreate=0 then
  572.         call lineout tempfile, " <hr> <h3> Files </h3>"
  573.     call lineout tempfile,' <menu> '
  574.     IF FLIST.0=0 THEN
  575.            CALL LINEOUT TEMPFILE,'  <li> No files in ' adir
  576.     else
  577.            do jj=1 to flist.0
  578.              call lineout tempfile, '<li> ' flist.jj.name
  579.            end
  580.     call lineout tempfile,' </menu> <hr> '
  581.  
  582.  
  583.      if dodirs=1 & dirtop=0 then do
  584.        if iscreate<>1 then do
  585.          if adir="" then
  586.             call lineout tempfile, "  <h3> Subdirectories </h3>"
  587.          else
  588.             call lineout tempfile, "  <h3> Subdirectories of " adir ' </h3>'
  589.        end
  590.        else
  591.            call lineout tempfile,' <br> '
  592.  
  593.        call lineout tempfile, " <menu>  "
  594.        if dirlist.0=0 then
  595.          call lineout tempfile,' <LI> No subdirectories! '
  596.        else
  597.          do mm=1 to dirlist.0
  598.             if dirlist.ok.mm=1 then
  599.                 call lineout tempfile,' <li> ' dirlist.mm.name
  600.          end
  601.        call lineout tempfile,' </menu>  '
  602.      end                        /* dirall */
  603.  
  604.  
  605.    end                  /* no table section */
  606.  
  607. /* table of files and subds */
  608.    when dirtable=1 then do
  609.  
  610. /* setup a multi column table:: file names first, then subdirectories. */
  611.  
  612.      call lineout tempfile, "      <table border=0> "
  613.      if showsize=1 & showdate=1 then
  614.         call lineout tempfile, ' <th colspan=' tablecols '> files and subdirectories (size, date)'
  615.      else if showsize=1 then
  616.         call lineout tempfile, ' <th colspan=' tablecols '> files and subdirectories (size)'
  617.      else if showdate=1 then
  618.         call lineout tempfile, ' <th colspan=' tablecols '> files and subdirectories (date)'
  619.     else
  620.         call lineout tempfile, ' <th colspan=' tablecols '> files and subdirectories '
  621.  
  622.      call lineout tempfile, '<tr> '
  623.      ifoo=0
  624.      do mm=1 to flist.0
  625.        ifoo=ifoo+1
  626.        call lineout tempfile,'<td> ' flist.mm.name '</td> '
  627.        if ifoo>=tablecols then do
  628.             call lineout tempfile,' <tr> '
  629.             ifoo=0
  630.         end
  631.      end
  632.      if dodirs=1 then do
  633.         ifoo=ifoo+1
  634.         call lineout tempfile,'<td align="center">  ::::  </td> '
  635.         if ifoo>=tablecols then do
  636.             call lineout tempfile,' <tr> '
  637.             ifoo=0
  638.         end
  639.  
  640.         do mm=1 to dirlist.0
  641.           if dirlist.ok.mm=0 then iterate
  642.           ifoo=ifoo+1
  643.           call lineout tempfile,'<td>  <b> ' dirlist.mm.name ' </b> </td>'
  644.           if ifoo>=tablecols then do
  645.             call lineout tempfile,' <tr> '
  646.             ifoo=0
  647.           end
  648.         end
  649.  
  650.      end
  651.  
  652.      call lineout tempfile,' </table> '
  653.  
  654.    end
  655. /*table of file&subds, displayed file */
  656.    when filetable=1 then do
  657.      foo1=""
  658.      if tablefile<>0 then
  659.          if tablefile_mess<>0 then
  660.                 foo1=tablefile_mess
  661.           else
  662.                 foo1='Description from:'||tablefile
  663.  
  664.      if usedl=0 then do
  665.         call lineout tempfile, "      <table border=1> "
  666.         call lineout tempfile, ' <th ALIGN="center"> files and subdirectories '
  667.        if showsize=1  then call lineout tempfile,' <th align="center"> <tt> size </tt> '
  668.        if showdate=1 then call lineout tempfile,' <th align="center"> <tt> date </tt> '
  669.  
  670.        if filekey=1 then
  671.          if tablefile<>0 then
  672.             call lineout tempfile, ' <th  ALIGN="center"> ' foo1
  673.          ELSE
  674.             call lineout tempfile, ' <th ALIGN="left"> '
  675.        else
  676.          if tablefile<>0 then
  677.              call lineout tempfile, ' <th ALIGN="left"> ' foo1
  678.          else
  679.             call lineout tempfile, ' <th ALIGN="left"> '
  680.  
  681.         call lineout tempfile, '<tr> '
  682.       end
  683.       else  do             /* set up a dl */
  684.          if foo1<>" " then
  685.             call lineout tempfile,' <p> Files and directories (' foo1 ")"
  686.          else
  687.            call lineout tempfile,' <p> Files and directories '
  688.          call lineout tempfile ,'<p> <dl> '
  689.       end
  690.  
  691.      IDONE=0
  692.      do igoo=1 to flist.0
  693.  
  694.         if usedl=1 then do
  695.             if filekey=0 then
  696.                if igoo<=tablelines.0 then
  697.                   gotit=tablelines.igoo
  698.                 else
  699.                    gotit=' '
  700.             else
  701.                 gotit=sref_extract_block(dispdata,flist.igoo.afile,'{','}')
  702.             call lineout tempfile,'<dt> ' flist.igoo.name
  703.             call lineout tempfile,'<dd> <code> ' gotit '</code>  '
  704.             iterate
  705.          end
  706.  
  707. /* else, use a table, not a dl list  */
  708.  
  709.         call lineout tempfile,'<td> ' Flist.igoo.name '</td>'
  710.         if showsize=1 then call lineout tempfile,'<td> ' Flist.igoo.size '</td>'
  711.         if showdate=1 then call lineout tempfile,'<td> ' Flist.igoo.date '</td>'
  712.  
  713.         IDONE=IDONE+1
  714.  
  715. /* display lines as found (one line per cell */
  716.        if filekey=0 then do
  717.  
  718.           IF IDONE=1 & tableLINES.0=0 THEN
  719.               CALL LINEOUT TEMPFILE,' <TD> </td> '
  720.           else
  721.             IF tableLINES.0 >= IGOO THEN
  722.                call lineout tempfile,'<td> <code> ' tablelines.igoo '</code> </td> '
  723.             CALL LINEOUT TEMPFILE,' <TR> '
  724.         end
  725.  
  726. /* seach file for a key */
  727.         else do                 /* use keyed {xx} search */
  728.             gotit=sref_extract_block(dispdata,flist.igoo.afile,'{','}')
  729.             if gotit="" then
  730.                if tablefile<>0 then
  731.                   call lineout tempfile,' <td>  </td> <tr>'
  732.                 else
  733.                   call lineout tempfile,' <td>  </td> <tr>'
  734.  
  735.             else do                      
  736.                 call lineout tempfile,' <td> ' gotit  ' </td> <tr> '
  737.             end
  738.  
  739.         end
  740.      end
  741.  
  742.  
  743.      if usedl=0 then
  744.        CALL LINEOUT TEMPFILE,'  <td> ------ </td> <td> </td> <TR> '
  745.      else
  746.        call lineout tempfile,' <p> '
  747.  
  748.      if dodirs=1 then do
  749.  
  750.        do igoo=1 to DIRlist.0
  751.         if dirlist.ok.igoo=0 then iterate
  752.  
  753.         if usedl=1 then do
  754.             tooth=igoo+flist.0
  755.             if filekey=0 then
  756.                if tooth<=tablelines.0 then
  757.                    gotit=tablelines.tooth
  758.                else
  759.                     gotit=' '
  760.             else
  761.                 gotit=sref_extract_block(dispdata,dirlist.igoo.aname,'{','}')
  762.             call lineout tempfile,'<dt> ' dirlist.igoo.name
  763.             call lineout tempfile,'<dd> <code> ' gotit '</code>  '
  764.             iterate
  765.          end
  766.  
  767. /* else, use a table, not a dl */
  768.          call lineout tempfile,'<td> ' DIRlist.igoo.name '</td>'
  769.          idone=idone+1
  770.          if filekey=0 then do
  771.            IF IDONE=1 & tableLINES.0=0 THEN
  772.                CALL LINEOUT TEMPFILE,' <TD> <EM> No such file (or empty) </em> '
  773.            else do
  774.               tooth=igoo+flist.0
  775.               IF tableLINES.0 >= tooth THEN 
  776.                 call lineout tempfile,'<td> <code> ' tablelines.tooth '</code> </td> '
  777.            end
  778.            CALL LINEOUT TEMPFILE,' <TR> '
  779.          end
  780.          else do                /* keyed read.me file */
  781.             gotit=sref_extract_block(dispdata,dirlist.igoo.aname,'{','}')
  782.             if gotit="" then
  783.                 call lineout tempfile,' <td>  </td> <tr>'
  784.             else do
  785.                 call lineout tempfile,' <td> ' gotit  ' </td> <tr> '
  786.             end
  787.          end
  788.  
  789.        end                      /* dirlist.0 */
  790.       end   /* DO DIRS */
  791.  
  792.  
  793.       if usedl=1 then
  794.              call lineout tempfile,' </dl> '
  795.        else
  796.              call lineout tempfile,' </table> '
  797.  
  798.  
  799.    END          /* FILETABLE=1 */
  800.  
  801.    otherwise
  802. end
  803.  
  804. if readmefile<>0 & attop=0 then do
  805.     call showdafile(readmelines.0)
  806. end
  807.  
  808. if iscreate=1 then do
  809.   call lineout tempfile,' <p><em> ' servername() adir '</em>'
  810. end
  811. call lineout tempfile,' </body> </html> '
  812. call lineout tempfile
  813. return 'FILE ERASE TYPE text/html NAME' tempfile
  814.  
  815.  
  816.  
  817. /*******/
  818. /* IMAGETYPE: Return the name of the image file to use based on file type */
  819. /*******/
  820.  
  821. imagetype: procedure expose ImagePath ImageSize
  822.   size = ImageSize
  823.  
  824.   e=extension(arg(1))
  825.  
  826.   select
  827.     when e='TXT' | e='CMD' | e='DOC' | e='FAQ' | e='SAS'
  828.       then return '<img src="'ImagePath'text.gif"' size 'alt="[text]">'
  829.     when e='HTM' | e='HTML'
  830.       then return '<img src="'ImagePath'text.gif"' size 'alt="[html]">'
  831.     when e='PS'
  832.       then return '<img src="'ImagePath'text.gif"' size 'alt="[ps]  ">'
  833.     when e='EXE' | e='ZIP' | e='ARC' | e='ARJ'
  834.       then return '<img src="'ImagePath'binary.gif"' size 'alt="[bin] ">'
  835.     when e="AU" | e="WAV" | e="MID"  | e="SND"
  836.       then return '<img src="'ImagePath'sound.gif"' size 'alt="[snd] ">'
  837.     when e="GIF" | e="JPG" | e="JPEG" | e="TIF" | e="TIFF" | e="BMP"
  838.       then return '<img src="'ImagePath'image.gif"' size 'alt="[img] ">'
  839.     when e="MPG" | e="MPEG" | e="AVI"
  840.       then return '<img src="'ImagePath'movie.gif"' size 'alt="[mov] ">'
  841.     otherwise
  842.       return '<img src="'ImagePath'unknown.gif"' size 'alt="[file]">'
  843.   end
  844.  
  845.  
  846. extension: procedure
  847. arg filename
  848. /* If no period or only period is first char, then return "" */
  849. if lastpos(".",filename)<2 then return ""
  850. return translate(substr(filename, lastpos('.',filename)+1))
  851.  
  852.  
  853.  
  854. /************/
  855. /* display the readmefile */
  856. showdafile:             /* display the file */
  857.  
  858.   parse arg mlines
  859.   call lineout tempfile,' <hr> '
  860.   if readmefile_mess=0 | readmefile_mess="" then readmefile_mess=' Displaying: ' ||readmefile
  861.   if mlines = 0 then 
  862.     nop
  863.   else do
  864.      call lineout tempfile,' <h3> ' readmefile_mess ' </h3> <pre> '
  865.      do mm=1 to mlines
  866.          call lineout tempfile,readmelines.mm
  867.      end
  868.      call lineout tempfile, ' </pre> '
  869.      if notdone=1 then
  870.         call lineout tempfile,' <br> <em> Only first ' mlines ' lines are displayed </em> '
  871.   end
  872.   call lineout tempfile,' <hr> '
  873.   return 0
  874.  
  875.  
  876.  
  877. error_1:
  878.      call lineout tempfile, "<h3>Could not get a file</h3"
  879.      call lineout tempfile, " <p> (probably a memory problem) "
  880.      call lineout tempfile, "<hr></body></html>"
  881.      call lineout tempfile                          /* close */
  882.      say " (GETAFILE) Memory problem ? "
  883.      foo=directory(olddir)
  884.      return 1
  885.  
  886. error_0:
  887.      if iscreate=0 then do
  888.         call lineout tempfile, "<h3>Could not get a file </h3>"
  889.         call lineout tempfile, " <p> The file directory does not exist: " adir
  890.      end
  891.      else
  892.         call lineout tempfile,' <br> Unavailable '
  893.      call lineout tempfile, "<hr></body></html>"
  894.      call lineout tempfile                          /* close */
  895.      say " DIR " adir " does not exist"
  896.      return 1
  897.  
  898. error_3:
  899.        call lineout tempfile, "<h3>Could not get a subdirectory</h3>"
  900.        call lineout tempfile, " <p> (probably a memory problem) "
  901.        call lineout tempfile, "<hr></body></html>"
  902.        call lineout tempfile                          /* close */
  903.        say " (GETAFILE) Memory problem ? "
  904.        return
  905.  
  906.